perm filename 423P2.SAI[JLG,SYS] blob
sn#815635 filedate 1986-04-22 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00016 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00003 00002 BEGIN "PUB2"
C00016 00003 SIMPLE INTEGER PROCEDURE BYTECOUNT(INTEGER BPNOW, BPTHEN)
C00031 00004 ONE ← 1 COMMENT TO FORCE ARRAY TO BE DYNAMIC
C00047 00005 BEGIN "INNER BLOCK"
C00055 00006 SIMPLE PROCEDURE UNDERSCORE(INTEGER RIGHTCHAR)
C00064 00007 SIMPLE PROCEDURE SLIDERROR
C00067 00008 IF PAGEHIGH THEN GO TO CONTINUE comment, re-entered
C00072 00009 WHILE (TOPLINE ← INNUM) > -10 DO
C00075 00010 CASE CHARTBL[PAGEBRC] OF
C00078 00011 4 ... CR -- Justify it
C00085 00012 ELSE BEGIN CHAR ← 0 MAX APPD(S)
C00094 00013 ELSE IF F="F" THEN FONTSELECT(S[3 FOR 1])
C00100 00014 5 ... LF BEGIN END
C00106 00015 IFC SAILVER OR PARCVER THENC
C00111 00016 BEGIN EXTERNAL SIMPLE PROCEDURE K!OUT K!OUT END COMMENT ** ** ** ** **
C00117 ENDMK
C⊗;
BEGIN "PUB2"
COMMENT NOTE THAT THE PARCVER USES MEMORY PAGES 700-712 AS A BUFFER ;
REQUIRE "[]<>" DELIMITERS ;
REQUIRE "SITE" SOURCE!FILE;
REQUIRE 6500 STRING!SPACE ;
DEFINE
PASSONE = [FALSE],
PASSTWO = [TRUE],
BEGOF(NAME) = [ ],
ENDOF(NAME) = [ ],
PROCEDURES = [ ],
FINISHED = [ ],
PUBLIC = [ ],
PRIVATE = [ ],
$ = ["],
# = [],
IFK = [IFC],
THENK = [THENC],
IFSITE = [IFK],
SITE(DUMMY) = [ ],
TERNAL = [] ;
REQUIRE "COMMON" SOURCE!FILE ;
COMMENT The Document Compiler -- Pass Two ;
COMMENT Pass One and Two share certain declarations, but in
one case, the meaning of a variable is different:
In Pass 1, XCRIBL is true for either
an XGP -or- PARC's MIC.
In Pass 2, XCRIBL is only true for an
XGP. MICRO is true for PARC's MIC
and RASTER is true for both. ;
COMMENT PASS 1 OUTPUT FORMAT FOR EACH PAGE :
Height Width MillLeftMargin MillRightMargin
For each area:
UpperLine NumCols NumLines
For each column:
LeftChar
For each non-null line:
Line Number
How far short of justification
Excess mill leading
Index of Intermediate Ascii File line
0
-10
PASS 2 reads the output file name and the intermediate page file names from
PUPSEQ.PUI, and the label table from PULABL.PUI. Then it reads
each page from each page file, processes each line in each of
its areas, and writes out a line printer image on the output file.
Each line is subject to three operations, in this order:
(1) Substitute label values at each vertical tab.
(2) Justify the line, if required, by inserting spaces at word breaks marked by altmodes.
(3) Generate underlining and super/sub-scripting as indicated by rubouts.
;
IFC CMUVER THENC REQUIRE "PUBTMP.SAI" SOURCE!FILE;
REQUIRE "CMUPUB.SAI" SOURCE!FILE;
ENDC COMMENT RKJ: 26-SEP-74 and 6-Feb-75;
DEFINE THRU = [STEP 1 UNTIL], DOWN = [STEP -1 UNTIL],
LH(X) = [(X LSH -18)], RH(X) = [(X LAND '777777)],
AWHILE = [WHILE TRUE],
INNUM = [WORDIN(ICHAN)],
SCN(BRKTBL)= [(IF FROMFILE THEN INPUT(SCHAN,BRKTBL) ELSE SCAN(OWL,BRKTBL,PAGEBRC))],
SCNUM = [CVD(SCN(TO!ALTMODE!SKIP))],
LPT = [1], TTY = [2], MIC = [3], XGP = [4],
HORIZ= ['40], VERTI= ['41], CSIZE= ['42], ULINE= ['43], RSPCS= ['44],
LSPCS= ['45], UDOTS= ['46], RDOTS= ['47], comment FR80 escape codes ;
FULSTR(X) = [LENGTH(X)], NULSTR(X) = [(LENGTH(X)=0)],
CR = ['15], LF = ['12], VT = ['13], FF = ['14], SP = ['40],
RUBOUT = ['177], TB = ['11],
ALTMODE = IFC TENEX THENC ['33] ELSEC
IFC SAILVER THENC ['175] ELSEC ['176] ENDC
ENDC,
TO!ALTMODE!SKIP = [1], TO!LF!APPD = [2],
ONE!CHAR = [3], BREAKER = [4], TO!RUB!ALT!SKIP = [5],
LOCAL!TABLE = [6],
FIML = [256],
ANS(A) = [(S = "A" OR S = "A" + '40)];
DEFINE COMMENT FOR XGP;
USEA= [('177&'14)], USEB= [('177&'15)], VSB= [('177&'20)],
XTAB= [('177&'30)],
XGPNUM(N)= [(((N) LSH -7) & (N))]; RKJ: 6-Feb-75 needed more ();
DEFINE ESCAPE1= [('177&'1)], ESCAPE2= [('177&'2)];
DEFINE CTLK = [11], CTLF= [6], CTLE= [5], CTLT= ['24], CTLQ= ['21];
IFC SAILVER THENC DEFINE RPGEXT = [".RPG"] ; ENDC
IFC CMUVER THENC
STRING PUIEXT; RKJ: 6-FEB-75;
ELSEC
PJ 5/28/74 ; DEFINE
PUIEXT = IFC ITSVER THENC [" PUI"] ELSEC [".PUI"] ENDC,
OCTEXT = IFC ITSVER THENC [" OCT"] ELSEC [".OCT"] ENDC,
TXTEXT = IFC ITSVER THENC [" ASC"] ELSEC [".ASC"] ENDC;
ENDC
TES 1/7/74 ; DEFINE CTLC= [3], CTLH= ['10], CTLR= ['22], CTLU= ['25], CTLS= ['23] ;
EXTERNAL INTEGER !SKIP! ;
INTEGER BRC, EOF ; COMMENT FOR FONTS TES 10/22/74 ;
INTEGER IML, IMC, comment, no. of lines and chars per page image ;
DEBUG, DEVICE, SEQCHAN, SEQBRC, SEQEOF, comment PUPSEQ.PUI info ;
LFTMAR, comment RASTER left margin (for tabs) ;
RGTMAR, comment RASTER right margin ;
INTRA, comment TES 6/11/74 PARC XGP Intra-line spacing (normally 3) ;
MILLVERTI, RASTVERTI, COMMENT TES 11/2/74 "NORMAL" INTERLINE FOR THIS DOC ;
LISTCHAN, comment output file ;
BAR, TES underlining character (or 0 if OFF) 10/22/73;
PAGEHIGH, PAGEWIDE, comment IML and IMC for latest page ;
I, J, K, L, M, N, DUMMY, comment general-purpose ;
LABCHAN, LABBRC, LABEOF, comment PULABL.PUI info ;
NL, comment LABTAB upper bound ; PAGECT, comment counts pages ;
TABLE, comment LABTAB first subscript -- selects Pass 1 NUMBER vs ITBL ;
ICHAN, SCHAN, FROMFILE, PAGEBRC, PAGEEOF, comment PUIn[S].PUI info ;
TOPLINE, NCOLS, NLINES, comment Area info ;
COL, LEFTCH, comment Column info ;
SLIDETOP, comment top of ∞ stacks such as SLIDESG ;
NCSIZE,CCSIZE, NHORIZ,CHORIZ, NVERTI,CVERTI, comment microfilm normal/current settings ;
NEEDCR, comment, assures CR before every LF for Stanford LPT ;
LINENO, MLEAD, SHORTM, SH, BRKS, FSTBRK, CHRS, FSTCHRS, SG, NOTFST, comment, Line info ;
TOTBRKS,
ONE, comment, 1 ;
BOTMAR, TOPMAR, RASTPHIGH, RASTPWIDE, RASTLHIGH, comment raster units ;
LINEY, CURRENTX, CURRENTY, DLBP, DLBP1, FSTFONT,
FONTSIZE, FROMTOP,
LINE, UNDERLINE, CHAR, F, G, LAST, LASL, AVAIL , comment, Justify info ;
JON1, JON2, JON3; COMMENT TEMPS FOR USE BY JLG;
INTEGER SCRIPT, comment baseline adjustment ;
THISFONT, comment PARC font number for scripts;
COPYNUMBER, comment PARC version or copy number ;
SCRLVL; comment baseline level ;
INTEGER TLFTMAR ; TVR temporary left margin in XGP pts;
BOOLEAN MICRO, RASTER ; TES 8/23/74 RASTER = XCRIBL OR MICRO ;
IFC CMUVER THENC BOOLEAN FIRST!OUTPUT ; ENDC RKJ: 10-SEP-74 ;
BOOLEAN NEEDFONTS ; TES 10/17/74 FOR PARC MIC ;
BOOLEAN NEEDVERTI ; TES 11/4/74 ;
BOOLEAN AUTOPACK ; TES 4/3/75 ;
INTEGER FSIZE; comment kludge for sliding foward references ;
EXTERNAL INTEGER RPGSW ;
STRING TMPFILE, LISTFILE, PAGEFILE, IFILE, SFILE, S, SR,
OWL, SS, T, ENDLINE, RESTARTLINE, ENDPAGE, DELINT, CRLF, JOBNO ;
STRING SPSSTR ; COMMENT A STRING OF 200 SPACES (TES 8/28/74) ;
TES 1/7/74 ; STRING CMDFILE ;
STRING INITIALLIST ; TES 3/29/75 ;
TES 3/20/74 ; STRING IFILENAME ; INTEGER IFICHAN ;
REAL RATIO, TERM, TERMX;
INTEGER ARRAY CHARTBL[0:127], OFSIZE,DIVISOR,XINFSTRL,SLIDESG,RB,LBD[1:5] ;
INTEGER ARRAY FNTSIZE,FNTCHAN[0:35] ;
INTEGER ARRAY SCRIPTPARAMS[0:7];
INTEGER ARRAY FNTEC, FNTBC, FNTSIZ, FNTFACE[0:35];
STRING ARRAY LBF[1:5] ;
STRING ARRAY PAGEFILES[1:100] ; TES 4/6/75 ;
INTEGER NPAGEFILES ; TES 4/6/75 ;
PRELOAD!WITH "", " ", " ", " ", " ", " ", " ",
" ", " ", " ", " " ;
THAFE STRING ARRAY SPSARR[0:10] ;
TES ADDED ALL PARC MIC STUFF ABOUT 8/28/74 : ;
IFCR PARCVER or sailver THENC
DEFINE
ELShowCharactersShort = '0,
ELSetSpaceXShort = '140,
ELFont = '160,
ELSetX = '356,
ELSetY = '357,
ELShowCharacters = '360,
ELSetSpaceX = '364,
ELResetSpace = '366,
ELShowRectangle = '376,
ELNop = '377,
ELSHOWOBJECT = '373,
MEOL = -1,
MICOUT(ARRY, COUNT) = [SOUT16(LISTCHAN, ARRY, COUNT)] ;
INTEGER PDIX, OUTCOUNT, TLIX, DLIX, DLREC, PDREC, DDREC;
INTEGER dlgone, DLbeg, ELbeg, SpaceX, BrkToChange;
INTEGER XPNeed, YPNeed, Pass2ScriptLevel, wordbreak;
INTEGER DLBPRESET ; TES 11/17/74;
INTEGER PressBug;
INTEGER ARRAY TL[0:4096], DL[0:12286], PD[0:'2000], NILS[0:'400];
ENDC
STRING TEMPSTR;
INTEGER BufCount, BufPtr;
REAL ARRAY YAboveBase, COMMENT BOUNDING BOX Y OFFSETS;
YBelowBase[0:16];
REAL LastMaxYAbove,
LastMaxYBelow,
MaxYAbove, comment used to position entities when fonts change;
MaxYBelow,
LastLine; comment needed to account for blank lines;
PRELOAD!WITH [128] 0 ; comment initialize array ;
INTEGER ARRAY Buf[0:127] ; comment added by jlj for BOUT16 ;
PRELOAD!WITH [6144] 0;
INTEGER ARRAY DLBuf[0:6143]; comment added by jlg 8/20/85 because
Parc version poorly uses pages 700-712;
PRELOAD!WITH "January", "February", "March", "April", "May", "June",
"July", "August", "September", "October", "November", "December";
THAFE STRING ARRAY MONTHS[1:12];
RKJ: 6-Feb-75 localize CMU code in separate file ;
IFCR CMUVER THENC
CMUCODES
ENDC
SIMPLE INTEGER PROCEDURE BYTECOUNT(INTEGER BPNOW, BPTHEN) ;
RETURN(
((RH(BPNOW)-RH(BPTHEN)) LSH 2) + (4-((BPNOW ROT 3) LAND 7)) ) ;
SIMPLE PROCEDURE WARN(STRING MESSG) ;
USERERR(0,1,MESSG) ;
INTEGER SIMPLE PROCEDURE READIN(STRING FILENAME; BOOLEAN BINARY ; REFERENCE INTEGER BRC, EOF) ;
BEGIN "READIN"
INTEGER CH, FLAG ;
CH ← GETCHAN ; EOF ← 0 ; OPEN(CH, "DSK", IF BINARY THEN 8 ELSE 0,2,0,150, BRC, EOF) ;
LOOKUP(CH, FILENAME, FLAG) ;
IF FLAG THEN WARN("Pass one said to read this file: " &
FILENAME & " but it does not exist") ;
RETURN(CH) ;
END "READIN" ;
comment parameter list changed by jlj to allow for binary mode output ;
INTEGER SIMPLE PROCEDURE WRITEON(STRING FILENAME; integer mode) ;
IFC TENEX THENC
OPENFILE(FILENAME, "WC") ;
ELSEC
BEGIN "WRITEON"
INTEGER CH ;
CH ← GETCHAN ; OPEN(CH, "DSK", mode,0,2,0, 0, 0) ;
AWHILE DO RKJ: 23-JUL-74 - CHECK FOR ENTER FAILURE ;
BEGIN
ENTER(CH, FILENAME, DUMMY←0);
IF NOT DUMMY THEN DONE;
OUTSTR("Cannot ENTER """ & FILENAME & """ Write file: ");
FILENAME←INCHWL;
END;
RETURN(CH);
END "WRITEON" ;
ENDC
IFC TENEX THENC
INTEGER SIMPLE PROCEDURE WRITE16(STRING FILENAME) ;
BEGIN "WRITE16"
INTEGER CH ;
CH ← GTJFN(FILENAME, 1) ;
IF CH<0 THEN WARN("Error in GTJFN of Document file " & FILENAME) ;
OPENF(CH, '200000100000) ;
IF !SKIP! THEN
BEGIN
ERSTR(!SKIP!,0) ;
WARN("Error opening Document file " & FILENAME) ;
END ;
RETURN(CH) ;
END "WRITE16" ;
ENDC
STRING SIMPLE PROCEDURE MICROFILM(INTEGER OP, ARG) ;
RETURN('177 & OP & (IF OP LEQ '42 THEN (ARG DIV 128)&(ARG MOD 128) ELSE ARG)) ;
STRING SIMPLE PROCEDURE SETSIZE(INTEGER N) ; RETURN(MICROFILM(CSIZE, CCSIZE ← N)) ;
STRING SIMPLE PROCEDURE SETHORIZ(INTEGER N) ; RETURN(MICROFILM(HORIZ, CHORIZ ← N)) ;
STRING SIMPLE PROCEDURE SETVERTI(INTEGER N) ; RETURN(MICROFILM(VERTI, CVERTI ← N)) ;
STRING SIMPLE PROCEDURE DOULINE(INTEGER N) ; RETURN(MICROFILM(ULINE, N)) ;
STRING SIMPLE PROCEDURE DORSPCS(INTEGER N) ; RETURN(MICROFILM(RSPCS, N)) ;
STRING SIMPLE PROCEDURE DOLSPCS(INTEGER N) ; RETURN(MICROFILM(LSPCS, N)) ;
STRING SIMPLE PROCEDURE DOUDOTS(INTEGER N) ; RETURN(MICROFILM(UDOTS, N)) ;
STRING SIMPLE PROCEDURE DORDOTS(INTEGER N) ; RETURN(MICROFILM(RDOTS, N)) ;
RECURSIVE STRING PROCEDURE VARBLANK(INTEGER N);
BEGIN "VARBLANK"
IFC CMUXGP THENC
IF N LEQ 0 THEN RETURN(NULL) ELSE
IF N GEQ 128 THEN RETURN(VSB & 127 & VARBLANK(N-127)) ELSE
RETURN(VSB&N)
ELSEC IFC SAILXGP THENC
IF N LEQ 0 THEN RETURN(NULL) ELSE
IF N GEQ 64 THEN RETURN(ESCAPE2 & 63 & VARBLANK(N-63)) ELSE
RETURN(ESCAPE2&N)
ELSEC IFC PARCVER THENC
RETURN(CTLE&CVS(N)&".")
ENDC ENDC ENDC;
END "VARBLANK";
INTERNAL STRING SIMPLE PROCEDURE SPS(INTEGER N) ;
IF N LEQ 10 THEN RETURN(SPSARR[N MAX 0])
ELSE IF DEVICE=MIC THEN RETURN(DORSPCS(N))
ELSE RETURN(SPSSTR[1 TO N]) ;
IFC TENEX THENC
STRING PROCEDURE SCANTO(STRING BRKS; REFERENCE STRING SCANNEE; BOOLEAN INCLUDE) ;
BEGIN
INTEGER DUMMY ;
SETBREAK(LOCAL!TABLE, BRKS, NULL, IF INCLUDE THEN "IA" ELSE "IR") ;
RETURN(SCAN(SCANNEE, LOCAL!TABLE, DUMMY)) ;
END ;
ENDC
IFC PARCVER THENC PARCOUT ENDC
IFC SAILVER THENC
SIMPLE PROCEDURE BOUT16(INTEGER X, CHAN) ;
BEGIN
INTEGER i ;
BufCount ← BufCount - 1; comment # words remaining in the buffer ;
IDPB(X, BufPtr) ; comment deposit byte X into Buf ;
if BufCount ≤ 0 then begin comment output the buffer ;
ARRYOUT(CHAN, Buf[0], 128) ; comment dump words ;
for i ← 0 thru 127 do
Buf[i] ← 0 ; comment re-initialize Buf ;
BufCount ← 256 ; comment # words in a record ;
BufPtr ← Point(16,Buf[0],-1) ;
end ;
END "BOUT16" ;
SIMPLE PROCEDURE SOUT16(INTEGER CHAN; INTEGER ARRAY LOC; INTEGER COUNT) ;
BEGIN
INTEGER i ;
OUTCOUNT ← OUTCOUNT + COUNT ; comment OUTCOUNT = total # words written ;
FOR I ← 0 THRU (COUNT - 1) DO
BOUT16(LOC[i], CHAN); comment output the bytes ;
END "SOUT16";
SIMPLE INTEGER PROCEDURE MICPAD ;
BEGIN
INTEGER N ;
N ← 256 - OUTCOUNT MOD 256 ;
IF N < 0 THEN WARN("PUB BUG -- TOO MUCH IN A RECORD") ;
IF N < 256 THEN MICOUT(NILS, N) ;
IF OUTCOUNT MOD 256 THEN
WARN("PUB BUG -- TOO LITTLE IN A RECORD") ;
RETURN(OUTCOUNT DIV 256) ; COMMENT NO. OF NEXT RECORD ;
END "MICPAD" ;
SIMPLE PROCEDURE WISHPMAP ;
BEGIN "WISHPMAP"
INTEGER DLOC, SDP, COUNT ;
DLOC ← LOCATION(DL[0]) ;
SDP ← Point(16, DLBuf[0], -1);
COUNT ← (BYTECOUNT(DLBP,DLBP1) + 1) DIV 2;
START!CODE "WISH"
LABEL LOOP ;
MOVN '13,COUNT ;
MOVE '14,DLOC ;
HRL '14,'13 ;
MOVE '13, SDP ;
LOOP: ILDB '15, '13 ;
MOVEM '15, 0('14) ;
AOBJN '14, LOOP ;
MOVEM '13,SDP ;
END "WISH" ;
MICOUT(DL, COUNT) ;
END "WISHPMAP" ;
Comment Routines for dealing with the EL;
simple procedure ELByte (integer b);
begin integer j;
j←TLIX div 2;
b←b land '377;
TL[j]←(if (TLIX land 1)=0 then b lsh 8 else b+TL[j]);
TLIX←TLIX+1;
end;
simple procedure ELWord (integer b);
begin ELByte(b lsh -8); ELByte(b) end;
simple procedure ELDWord (integer b);
begin ELWord(b lsh -16); ELWord(b) end;
simple integer procedure ELPos;
return (TLIX);
procedure ELOut;
begin integer i,j;
j←TLIX; if (j land 1)=1 then warn("EL bug");
j←j div 2;
MICOUT(TL, j);
TLIX←0;
end;
Comment Routines for putting things into the EL.;
simple procedure SetPosD(integer code,pos);
begin
if code=ELSetX then XPNeed←-1 else YPNeed←-1;
ELByte(code);
ELWord(pos);
end;
simple procedure Show;
if dlgone then begin
if XPNeed neq -1 then SetPosD(ELSetX,XPNeed);
if YPNeed neq -1 then SetPosD(ELSetY,YPNeed);
while dlgone do begin
integer i;
i←dlgone min 255;
if i leq 32 then ELByte(ELShowCharactersShort+i-1)
else begin
ELByte(ELShowCharacters);
ELByte(i);
end;
dlgone←dlgone-i;
end;
end;
simple procedure SetPos(integer code,pos);
begin
Show; comment flush out existing characters;
if code=ELSetX then XPNeed←pos else YPNeed←pos;
end;
simple procedure SetSpace(integer s);
begin
Show;
SpaceX←s;
if s<2048 then ELWord((ELSetSpaceXShort lsh 8)+s) else
begin
ELByte(ELSetSpaceX);
ELWord(s);
end;
end;
simple procedure BCPLString(string s; integer maxlen);
begin integer i;
ELByte(maxlen min length(s));
for i←1 thru maxlen do
ELByte(if i>length(s) then 0 else s[i for 1]);
end;
Comment The routine that computes how much to go up/down
for super/sub scripts;
simple integer procedure SubSuperAmt(integer dir,rasthigh);
begin integer firstone,nlevel,dosuper,ix;
nlevel←Pass2ScriptLevel+dir;
firstone←(Pass2ScriptLevel=0) or (nlevel=0);
dosuper←(Pass2ScriptLevel>0) or (nlevel>0);
ix←(if firstone then 0 else 2)+(if dosuper then 0 else 4);
Pass2ScriptLevel←nlevel;
Comment Value is a+b*high/1000, where a in micas;
return(SCRIPTPARAMS[ix]+(SCRIPTPARAMS[ix+1]*rasthigh)%1000);
end;
ENDC;
comment done with new code ;
STRING SIMPLE PROCEDURE SPARAM ;
BEGIN "SPARAM"
STRING S ;
S ← NULL ;
DO S ← S & INPUT(SEQCHAN, TO!ALTMODE!SKIP) UNTIL SEQBRC = ALTMODE OR SEQEOF ;
RETURN(S) ;
END "SPARAM" ;
INTEGER SIMPLE PROCEDURE IPARAM ; RETURN(CVD(SPARAM)) ;
IFC CMUXGP THENC RKJ: 29-AUG-74;
INTEGER SIMPLE PROCEDURE INDEX2(STRING A,B);
comment returns the location of the first occurance of
the string B in A, 0 if none;
BEGIN "INDEX2"
INTEGER LA, LB;
IF (LB←LENGTH(B))=0 THEN RETURN(1);
IF (LA←LENGTH(A)-LB+1) LEQ 0 THEN RETURN(0);
START!CODE
LABEL L1, L2, OUTT, NEXT;
MOVE 2,A; MOVN 1,LA; ILDB 0,B; SOS 0,LB;
L1: ILDB 3,2; CAME 3,0; NEXT: AOJL 1,L1;
JUMPE 1,OUTT;
MOVE 4,2; MOVE 5,B; MOVE 6,LB;
L2: ILDB 7,4; ILDB '10,5; CAME 7,'10; JRST NEXT; SOJG 6,L2;
ADD 1,LA; AOJ 1,0;
OUTT:
END;
END "INDEX2";
SIMPLE STRING PROCEDURE FIXUP(STRING S);
BEGIN "FIXUP"
INTEGER ALOC,BLOC;
IF NOT XCRIBL THEN RETURN(S) ; RKJ: 28-SEP-74 ;
IF (ALOC←INDEX2(S,USEA))=1 THEN RETURN(S);
IF (BLOC←INDEX2(S,USEB))=1 THEN RETURN(S);
IF ALOC=0 THEN ALOC←BLOC;
IF BLOC=0 THEN BLOC←ALOC;
ALOC←ALOC MIN BLOC;
RETURN(S[ALOC FOR 2]&S[1 TO ALOC-1]&S[ALOC+2 TO ∞]);
END "FIXUP";
ELSEC
DEFINE FIXUP(X)="X";
ENDC
IFC TENEX THENC
SIMPLE PROCEDURE SFBSZ(INTEGER CHAN, SIZE) ;
BEGIN "SFBSZ"
INTEGER K ;
DEFINE JSYS=['104000000000], SFBSZ=[JSYS '46];
K ← CVJFN(CHAN) ;
START!CODE "BYTE16"
MOVE 1,K; MOVE 2,SIZE; SFBSZ ;
END "BYTE16" ;
END "SFBSZ" ;
ENDC
ONE ← 1 ; COMMENT TO FORCE ARRAY TO BE DYNAMIC ;
BEGIN "VARIABLE BOUND ARRAY BLOCK"
THAFE INTEGER ARRAY CW[-1:ONE] ; comment cw[-1] is used to determine font type;
REQUIRE "DATUM" SOURCE!FILE ;
REQUIRE "FILES" SOURCE!FILE ;
REQUIRE "FONTS" SOURCE!FILE ;
RKJ: 6-FEB-75 MOVED UNMASH TO OUTER BLOCK;
SIMPLE STRING PROCEDURE UNMASH(STRING Q) ;
BEGIN TES 8/14/74 PACK EXCESS-64 4-BIT BYTES INTO 7-BIT BYTES ;
STRING S ; S ← NULL ;
WHILE FULSTR(Q) DO S ← S & (((LOP(Q)-64)LSH 4) + (LOP(Q)-64)) ;
RETURN(S) ;
END ;
comment hopefully won't need since it is for OLDMIC, but double check. jlj ;
IFC PARCVER THENC IFC OLDMIC THENC
SIMPLE INTEGER PROCEDURE INITIALAPPD(STRING S) ; PARCAPPD ; TES 3/29/75 ;
ENDC ENDC
COMMENT I N I T I A L I Z E ;
WCW ← WHATIS(CW) ;
IFC PARCVER THENC
SR ← NULL ;
DUMMY←CVSIX("PUB2 ");
START!CODE
MOVE 1,DUMMY;
'104000000210;
END;
ARRCLR(NILS, 1) ;
ENDC
SPSSTR ← SP ;
FOR I ← 1 THRU 200 DO SPSSTR ← SPSSTR & SP ; TES 8/28/74 ;
SCRIPT ← 10;
IFC TENEX THENC JOBNO ← CVS(GJINF(DUMMY, DUMMY, DUMMY)) ; ENDC TES 10/25/73 ;
IFC CMUVER THENC JOBNO ← ("0" & CVS(CALL(0,"PJOB")))[INF-1 FOR 2] ; ENDC RKJ: 6-FEB-75 ;
IFC PARCVER THENC IML←65; IMC←72; ENDC
IFC SAILVER THENC IML←53; IMC←69; ENDC
IFC ITSVER THENC IML←55; IMC←69; ENDC PJ 5/28/74 ;
IFC CMUVER THENC IML←55; IMC←69; ENDC
IFC ISIVER THENC IML←55; IMC←69; ENDC
PAGEHIGH ← PAGEWIDE ← PAGECT ← 0 ; CRLF ← CR & LF ;
SETBREAK(ONE!CHAR, NULL, NULL, "XA") ;
SETBREAK(TO!ALTMODE!SKIP, ALTMODE, NULL, "IS") ;
SETBREAK(TO!LF!APPD, LF, NULL, "IA") ;
SETBREAK(BREAKER, RUBOUT&VT&ALTMODE&CR&LF, NULL, "IS") ;
SETBREAK(TO!RUB!ALT!SKIP, RUBOUT&ALTMODE, NULL, "IS") ;
IFC TENEX THENC
IF RPGSW THEN
BEGIN
IFICHAN ← READIN(JOBNO & ".PASS2", FALSE, DUMMY, DUMMY) ;
IFILENAME ← INPUT(IFICHAN, TO!ALTMODE!SKIP) ;
RELEASE(IFICHAN) ; TES 6/11/74 ;
END
ELSE BEGIN TES 6/11/74 REVISED ;
OUTSTR("MANUSCRIPT: ") ;
WHILE -1 = (J ←
GTJFNL(NULL, '162000000000, '100000101,
NULL, NULL, NULL, "PUB", NULL, NULL, NULL)) DO
OUTSTR(" ?" & CRLF & "MANUSCRIPT: ") ;
IFILENAME ← JFNS(J, '1000000000) ;
RLJFN(J) ;
END ;
ENDC
IFC CMUVER THENC
OPEN(SEQCHAN←GETCHAN,"DSK",'17,0,0,0,0,0);
AWHILE DO
BEGIN
LOOKUP(SEQCHAN,"PUPSEQ"&(PUIEXT←"."&JOBNO&"I"),DUMMY);
IF NOT DUMMY THEN DONE;
OUTSTR("cannot find intermediate files."&CRLF&
"under what job number did you run Pass 1? ");
JOBNO←("0" & INCHWL)[INF-1 FOR 2];
END;
RELEASE(SEQCHAN);
ENDC RKJ: 6-FEB-75 ;
SEQCHAN ← READIN(
IFC TENEX THENC IFILENAME&".FILES" ELSEC "PUPSEQ"&PUIEXT ENDC,
FALSE, SEQBRC, SEQEOF) ;
TMPFILE ← SPARAM ;
LISTFILE ← SPARAM ;
TEMPSTR ← "";
FOR I ← 1 THRU LENGTH(LISTFILE) DO
IF LISTFILE[I FOR 1] ≠ " " THEN
TEMPSTR ← TEMPSTR & LISTFILE[I FOR 1];
LISTFILE ← TEMPSTR;
PRINT(LISTFILE);
DEBUG ← IPARAM ;
DEVICE ← IPARAM ;
XCRIBL ← DEVICE=XGP ;
BufCount ← 256 ; comment for BOUT16. # free 16 bit bytes left in Buf ;
BufPtr ← POINT(16, Buf[0], -1) ; comment for BOUT16. where to dump output bytes ;
IFC PARCVER or sailver THENC
MICRO ← DEVICE=MIC ;
PDIX ← OUTCOUNT ← 0 ;
IF MICRO THEN
BEGIN
DLBP1 ← Point(8, DLBuf[0], -1);
DLBP ← DLBP1;
END ;
ELSEC MICRO ← FALSE ; ENDC ;
RASTER ← MICRO OR XCRIBL ;
DELINT ← SPARAM ;
FWFILE ← SPARAM ;
LOFONT ← IPARAM ; HIFONT ← IPARAM ;
AUTOPACK ← IPARAM ; TES 4/3/75 ;
NEEDFONTS ← FALSE ; TES 10/17/74 ;
IF NOT AUTOPACK THEN NEEDFONTS ← TRUE ; TES 4/3/75 ;
FOR J ← LOFONT THRU HIFONT DO
IF FULSTR(FNTNAME[J] ← SPARAM) THEN
BEGIN
BRC ← FNTFIL[J] ← CREATE(-1,255) ; MAKEBE(BRC, CW) ;
READFONT(J, FNTNAME[J], NULL);
END;
IFC SAILVER OR PARCVER THENC
IF MICRO AND (NEEDFONTS OR AUTOPACK) THEN
BEGIN TES 10/17/74 ;
K ← -1 ;
FOR J ← LOFONT THRU HIFONT DO IF FULSTR(FNTNAME[J]) THEN
FNTNUMBER[J] ← K ← K + 1 ;
END ;
ENDC
CMDFILE ← SPARAM ;
BAR ← SPARAM[1 FOR 1] ;
IF BAR = SP THEN BAR ← 0 ; TES 10/22/73 ;
CHARW ← IPARAM;
NEEDVERTI ← FALSE ;
IF (MILLVERTI←IPARAM) LEQ 0 THEN
BEGIN
INTRA ← IFC NOT SAILXGP THENC 0 ; ENDC
MILLVERTI ← ABS(MILLVERTI) ;
NEEDVERTI ← RASTER ;
END
ELSE INTRA ← MILLVERTI ;
BASELINE ← IPARAM; BASELINE←BASELINE+(BASELINE DIV 4);
DOPASS3 ← IPARAM; RKJ: 1-4-74;
IFC CMUVER THENC FIRST!OUTPUT ← NOT DOPASS3 ; ENDC RKJ: 28-SEP-74 ;
VBPI ← IPARAM ;
HBPI ← IPARAM ;
MINLFTMAR ← IPARAM ;
TOPMAR ← (IPARAM*VBPI + 500) DIV 1000 ; TES 1/26/74 ;
BOTMAR ← (IPARAM*VBPI + 500) DIV 1000 ; TES 1/26/74 ;
begin DCS Super/Sub script parameters from file; integer def,i,v;
def←true;
for i←0 thru 7 do begin
v←IPARAM;
if v neq 0 then def←false;
SCRIPTPARAMS[i]←v;
end;
if def then for i←0 step 2 until 6 do begin
SCRIPTPARAMS[i]←0;
SCRIPTPARAMS[i+1]←333;
end;
end;
INTRA ← (INTRA*VBPI + 500) DIV 1000 ; TES 11/2/74 ;
RASTVERTI ← (MILLVERTI*VBPI + 500) DIV 1000 ; TES 11/2/74 ;
IF NOT RPGSW AND NOT RASTER THEN COMMENT STARTED BY ".R PUB2" ;
DO BEGIN
OUTSTR("OUTPUT DEVICE (LPT or TTY): ") ;
S ← INCHWL ;
DEVICE ← IF ANS(L) THEN LPT ELSE IF ANS(T) THEN TTY ELSE 0 ;
END
UNTIL DEVICE ;
IF NOT RPGSW AND DEBUG THEN
IF DEVICE = MIC THEN DEBUG ← 0
ELSE DO BEGIN
OUTSTR("Debug info in right margin? (Y or N) = ") ;
S ← INCHWL ;
DEBUG ← IF ANS(Y) THEN -1 ELSE IF ANS(N) THEN 0 ELSE 100 ;
END
UNTIL DEBUG < 100 ;
ENDLINE ← LF ; ENDPAGE ← FF ;
IFC PARCVER or sailver THENC IF MICRO THEN ENDLINE ← MEOL ; ENDC
RESTARTLINE ←
IFC PARCVER THENC IF XCRIBL THEN CTLT&"0." ELSE CR
ELSEC CR ENDC ; TES 11/1/73 ;
IFC SAILVER THENC
CASE DEVICE-1 OF
BEGIN "DEV"
comment 1...LPT ; LISTCHAN ← WRITEON(LISTFILE,0) ;
comment 2...TTY ; LISTCHAN ← WRITEON(LISTFILE,0) ;
comment 3...MIC ; LISTCHAN ← WRITEON(LISTFILE, '10);
comment 4...XGP ; LISTCHAN ← WRITEON(LISTFILE,0)
END "DEV" ;
ENDC;
IFC TENEX THENC LISTFILE ← JFNS(LISTCHAN, 0) ; ENDC ;
J ← 0 ; FOR K ← RUBOUT, ALTMODE, VT, CR, LF DO CHARTBL[K] ← J ← J + 1 ;
LABCHAN ← READIN(
IFC TENEX THENC IFILENAME&".LABELS" ELSEC "PULABL"&PUIEXT ENDC,
FALSE, LABBRC, LABEOF) ;
NL ← CVD(INPUT(LABCHAN, TO!ALTMODE!SKIP)) ;
LASL ← 1000 ; comment, last physical line occupied on the page ;
S←INPUT(SEQCHAN,TO!LF!APPD); comment get to right place ;
IFC PARCVER THENC
IF MICRO THEN INITIALLIST ← SPARAM ;
ENDC
TES 1/7/74 ADDED : TES 6/11/74 WITH INTRA:;
IFC PARCVER THENC
IF XCRIBL THEN OUT(LISTCHAN,
(RUBOUT&CTLC) & CMDFILE &
("K EFHJKLMQRSTU" & CR & "I " & CVS(INTRA) &
CR & "M 0" & CR & "W 1600" & CR & "E" & CR)) ;
COMMENT
CTLC Initiallize switches (used as RUBOUT CTLC)
CTLE Variable blank
CTLF Font change
CTLH Overstrike
CTLJ=LF Line Feed
CTLK Vertical Spacing
CTLL=FF Form Feed
CTLM=CR Carriage Return
CTLQ Quote control character
CTLR Return to baseline from ript
CTLS Subscript
CTLT Tab
CTLU Superscript
RUBOUT Treat as control character (inverse CTLQ)
;
IFC OLDMIC THENC
IF MICRO AND AUTOPACK THEN BEGIN PARCINITIALLIST END ; TES 4/3/75 ;
ENDC
DLBP ← DLBP1 ;
OUTCOUNT ← 0 ;
ENDC
IFC SAILVER THENC
IF XCRIBL THEN
OUT(LISTCHAN,"/LMAR="&CVS(LFTMAR)&"/XLINE="&CVS(INTRA)&CMDFILE&CRLF&FF) ;
ENDC
IFC ITSVER THENC PJ 8/24/74 ;
IF XCRIBL THEN
BEGIN
OUT(LISTCHAN,";LFTMAR "&CVS(LFTMAR)&CRLF&
";VSP "&CVS(INTRA)&CRLF&
";SKIP 1"&CRLF);
SETBREAK(LOCAL!TABLE,CR,NULL,"IA") ;
DO OUT(LISTCHAN, SCAN(CMDFILE, LOCAL!TABLE, BRC)&LF ) UNTIL BRC NEQ CR ;
OUT(LISTCHAN, FF);
SETBREAK(LOCAL!TABLE,NULL,NULL,"IS");
END;
ENDC
IFC CMUVER THENC
IF XCRIBL THEN OUT(LISTCHAN,UNMASH(CMDFILE)&
CMU!FMT(1)&
(IF NEEDVERTI THEN CMU!VS(INTRA) ELSE NULL));
ENDC
BEGIN "INNER BLOCK"
STRING ARRAY LABTAB[0:1, 0:NL], OWLS[0:FIML-1] ;
AWHILE DO
BEGIN "LABEL"
TABLE ← CVD(INPUT(LABCHAN, TO!ALTMODE!SKIP)) ; IF LABEOF THEN DONE ;
LABTAB[TABLE, CVD(INPUT(LABCHAN, TO!ALTMODE!SKIP))] ←
INPUT(LABCHAN, TO!ALTMODE!SKIP) &
(IF RASTER THEN
(ALTMODE & INPUT(LABCHAN, TO!ALTMODE!SKIP))
ELSE NULL);
END "LABEL" ;
RELEASE(LABCHAN);
COMMENT G O ! ;
IF MICRO THEN IML ← 1 ; COMMENT SAVE STORAGE ;
DO comment, This loop is re-entered only if page image grows ;
BEGIN "SIZE"
THAFE STRING ARRAY IMG[1:IML+IML], SEG[0:8*IMC], SRCREF[1:IML] ;
THAFE INTEGER ARRAY LINK,FAKE,LASC[1:IML+IML], LEADING,SNUCK[1:1000]; TES ?IML+1] ; RKJ: 6-FEB-75 SNUCK ;
LABEL CONTINUE ;
INTEGER SIMPLE PROCEDURE APPD(STRING S) ;
IFC PARCVER THENC PARCAPPD ENDC
Comment
Body of INITIALAPPD(s) and APPD(s), the two basic routines
that write out text characters. This routine IDPB's chars
into the output buffer, and accounts the widths as it does
so. Current X position is saved in CURRENTX, and
is updated. CW must point to an array of widths (micas). ;
IFC SAILVER THENC
comment "MAPPD" performed only when DEVICE = MIC, otherwise, APPD performed ;
IF MICRO THEN TES 10/9/74 REVISED FOR CURRENTX ;
BEGIN "MAPPD"
INTEGER SRC,len,spcnt ;
len←LENGTH(S);
IF len=0 THEN RETURN(CHAR) ;
if PressBug then Outstr(s);
spcnt←0;
QUICK!CODE "MAPPEND"
LABEL LOOP ;
DEFINE X=['13], BYTE=['14], CNT=['15];
MOVEI CNT, S ;
MOVE X, 0(CNT) ;
MOVEM X, SRC ;
HRRZ CNT,-1(CNT) ;
MOVE X, CURRENTX ;
LOOP:
ILDB BYTE, SRC ;
cain byte,SP;
aos spcnt;
IDPB BYTE, DLBP ;
ADD BYTE, CW ;
SKIPLE 1(BYTE) ; comment remember cw[-1] has another use;
ADD X, 1(BYTE) ; COMMENT ADD CHARACTER WIDTH ;
SOJG CNT, LOOP ;
MOVEM X, CURRENTX ;
END "MAPPEND" ;
DLBPRESET ← -1 ; TES 11/17/74;
if spcnt neq 0 and wordbreak=false and SpaceX neq -1 then begin
Show; comment put out chars not including these;
ELByte(ELResetSpace);
dlgone←dlgone+len;
Show;
SetSpace(SpaceX);
end else dlgone←dlgone+len;
RETURN(CHAR+len) ;
END "MAPPD"
ELSE
ENDC
comment end new code ;
comment executed only if DEVICE ≠ MIC. ;
BEGIN "APPD"
INTEGER HAD, EXTRA, SPACES, F ; STRING T, SS ;
L ← LINE ; EXTRA ← LENGTH(S) ;
IF XCRIBL THEN
BEGIN TES 11/13/73 FOR MULTI-COLUMNS ;
IF CHAR < (HAD ← LASC[L]) THEN
BEGIN
FAKE[L] ← FAKE[L] + HAD - CHAR ;
HAD ← LASC[L] ← CHAR ;
END
END
ELSE
WHILE CHAR < (HAD ← LASC[L]) DO IF (F←LINK[L]) THEN L ← F ELSE
IF (LINK[L] ← AVAIL←AVAIL+1) > IML+IML THEN
WARN("Too much for one page: " & S)
ELSE L ← AVAIL ;
SPACES ← CHAR - HAD ; HAD ← HAD + FAKE[L] ;
T ← IMG[L] ;
IF LENGTH(T) < HAD+SPACES+EXTRA THEN
BEGIN comment no room -- must use concatenate ;
SS ← SPS(SPACES) ;
IF DEVICE=MIC THEN FAKE[L] ← FAKE[L] + LENGTH(SS) - SPACES ;
IMG[L] ← IF HAD THEN T[1 TO HAD]&SS&S ELSE (0&SS&S)[2 TO ∞]
END
ELSE BEGIN comment there's room in old string -- IDPB into it.;
SS ← T[HAD + 1 FOR 1] ; comment byte pointer to IDPB place ;
START!CODE "APPEND" LABEL LOOP1, LOOP2 ;
MOVE 1, SS ; MOVE 2, S ; MOVE 3, EXTRA ;
MOVE 4, SPACES ; JUMPE 4, LOOP2 ; MOVEI 5, '40 ; LOOP1: IDPB 5,1 ; SOJG 4,LOOP1 ;
LOOP2: ILDB 5, 2 ; IDPB 5, 1 ; SOJG 3, LOOP2 ;
END "APPEND" ;
END ;
RETURN(LASC[L] ← CHAR + EXTRA) ;
END "APPD" ;
COMMENT * * * * C T R L * * * * ;
SIMPLE PROCEDURE CTRL(STRING S) ;
BEGIN "CTRL"
CHAR ← 0 MAX APPD(S) - LENGTH(S) ;
LASC[L] ← CHAR ;
FAKE[L] ← FAKE[L] + LENGTH(S) ;
END "CTRL" ;
SIMPLE PROCEDURE MCTRL(INTEGER C) ;
BEGIN "MCTRL"
QUICK!CODE "MCTRLAPPEND"
LABEL RBYTE ;
DEFINE WD=['13] ;
MOVE WD, C ;
CAIG WD,'377 ;
JRST RBYTE ;
ROT WD, -8 ;
IDPB WD, DLBP ;
ROT WD, 8 ;
RBYTE:
IDPB WD, DLBP ;
END "MCTRLAPPEND" ;
END "MCTRL" ;
RKJ: 8-Nov-74 following code;
IFC CMUVER THENC
SIMPLE PROCEDURE CMUSCRIPT(INTEGER LEVEL; STRING S);
BEGIN "CMUSCRIPT" RKJ: modified 6-Feb-75 ;
STRING SCRIPT;
IF LEVEL>0 THEN SCRIPT←CMU!SUP(LEVEL,0) ELSE SCRIPT←CMU!SUB(-LEVEL,0);
WHILE FULSTR(S) DO
BEGIN CTRL(SCRIPT); CHAR←APPD(LOP(S)) END;
END "CMUSCRIPT";
ENDC
SIMPLE PROCEDURE UNDERSCORE(INTEGER RIGHTCHAR) ;
BEGIN "UNDERSCORE"
INTEGER NUMCHARS, DESCEND, SAVEHORIZ ;
NUMCHARS ← RIGHTCHAR - UNDERLINE ;
IF NUMCHARS > 0 THEN
BEGIN
SAVEHORIZ ← CHORIZ ;
DESCEND ← CCSIZE DIV 4 ;
CTRL( DOLSPCS(CHAR-UNDERLINE) & DOUDOTS(-DESCEND) & DOULINE(NUMCHARS-1) &
SETHORIZ(CCSIZE) & DOULINE(1) & DOLSPCS(1) & SETHORIZ(SAVEHORIZ) &
DOUDOTS(DESCEND) & DORSPCS(CHAR - RIGHTCHAR + 1) ) ;
UNDERLINE ← RIGHTCHAR ;
END ;
END "UNDERSCORE" ;
SIMPLE PROCEDURE CHANGESPACING ;
IF (N←CHRS-CHAR-1)>0 AND (K←(J←N*CHORIZ+SHORTM)/N MIN 511) NEQ CHORIZ THEN
BEGIN "CHANGESPACING"
IF UNDERLINE GEQ 0 THEN UNDERSCORE(CHAR) ;
SHORTM ← J - K*N ;
IF NOTFST AND (UNDERLINE<0 OR SHORTM<0) THEN
BEGIN CTRL(DORDOTS(SHORTM)) ; SHORTM ← 0 END ; TES CTRL 8/28/74;
CTRL(SETHORIZ(K)) ; NOTFST ← TRUE ;
END "CHANGESPACING" ;
SIMPLE PROCEDURE FONTSELECT(INTEGER WHICH);
BEGIN "FONTSELECT"
IF (WHICH←WHICH-"0")>9 THEN WHICH←WHICH-("A"-"0"-10);
THISFONT ← WHICH ; TES 10/17/74 ;
IFC CMUXGP THENC
WHICH←WHICH MOD 9; COMMENT MAKE 1,A 2,B EQUIVALENT;
IF WHICH=1 THEN CTRL(USEA) ELSE
IF WHICH=2 THEN CTRL(USEB) ELSE
WARN("Font " & CVS(WHICH) & " ignored")
ELSEC IFC SAILVER OR PARCVER THENC
comment Used to change fonts. Font number to switch to
is in WHICH (mapped via FNDNUMBER to PRESS font);
IF XCRIBL THEN
IF WHICH>16 THEN WARN("Font " & CVS(WHICH) & " ignored") ELSE
BEGIN
CTRL(ESCAPE1&(WHICH-1));
IF SCRLVL THEN CTRL(ESCAPE1&'43&SCRLVL);
END
ELSE IF MICRO THEN
IF 0 LEQ WHICH LEQ 15 THEN
BEGIN
IF (YBelowBase[WHICH] > MaxYBelow) THEN
MaxYBelow ← YBelowBase[WHICH];
IF (YAboveBase[WHICH] > MaxYAbove) THEN
MaxYAbove ← YAboveBase[WHICH];
Show;
ELByte(ELFont + FNTNUMBER[WHICH]) ;
WHICH←FNTFIL[WHICH] ; MAKEBE(WHICH,CW) ; TES 10/9/74 ;
END
ELSE WARN("FONT NUMBER OUT OF RANGE")
ENDC ENDC;
END "FONTSELECT";
STRING SIMPLE PROCEDURE XTABSTR(INTEGER N); RKJ: NEW 1-4-74;
BEGIN "XTABSTR"
IFC CMUXGP THENC RETURN(XTAB&XGPNUM(N)) ENDC
IFC SAILXGP THENC
RETURN(ESCAPE1&'40&XGPNUM(N))
ENDC
IFC PARCVER THENC
RETURN(CTLT&CVS(N)&".")
ENDC;
END "XTABSTR";
SIMPLE PROCEDURE XGPTAB(INTEGER N); RKJ: NEW 1-4-74;
CTRL(XTABSTR(N+TLFTMAR));
STRING PROCEDURE SCNBYCOUNT(INTEGER COUNT) ;
BEGIN
INTEGER I ; STRING S ;
S ← NULL ;
FOR I ← 1 THRU COUNT DO S ← S & SCN(ONE!CHAR) ;
RETURN(S) ;
END ;
IFC PARCVER THENC PARCLINE ENDC
IFC SAILVER THENC
SIMPLE PROCEDURE MICTAB(INTEGER N) ;
SetPos(ELSetx,CURRENTX←N+TLFTMAR) ;
SIMPLE PROCEDURE OPENLINE(INTEGER FSTTAB, XFSTFONT) ;
comment parameters are always (0, -1);
BEGIN "OPENLINE" TES 10/17/74 XFSTFONT ;
dlgone←0; ELbeg←ELPos;
DLbeg ← BYTECOUNT(DLBP, DLBP1) ;
IF XFSTFONT<0 THEN
CURRENTY ← LINEY ← LineY - ((Line - LastLine) *
(LastMaxYBelow + LastMaxYAbove + MillVerti));
IF XFSTFONT geq 0 then ELByte(ELFont+FNTNUMBER[XFSTFONT]);
SetPos(ELSetY, CURRENTY);
Pass2ScriptLevel←0; wordbreak←false;
MICTAB(FSTTAB) ;
BrkToChange←0; SpaceX←-1;
if totbrks neq 0 and SHORTM > 0 then
begin integer m;
m←SHORTM div totbrks;
n←SHORTM mod totbrks;
if n neq 0 then begin
m←m+1;
BrkToChange←n;
end;
if PressBug then Outstr("=="&cvs(totbrks)&","&cvs(shortm)&","&cvs(m));
SetSpace(m);
end;
END "OPENLINE" ;
SIMPLE PROCEDURE CLOSELINE ;
BEGIN "CLOSEL"
IF FULSTR(SR) THEN BEGIN MICTAB(RGTMAR-TLFTMAR) ; APPD(SR) ; SR←NULL END ;
Show;
if (ELPos land 1)=1 then ELByte(ELNop);
ELWord(0);
ELDWord(DLbeg);
ELDWord(BYTECOUNT(DLBP,DLBP1)-DLbeg);
ELWord(0); comment X OFFSET;
ELWord((-1) * MaxYAbove); COMMENT Y OFFSET;
ELWord(TLFTMAR); COMMENT LEFT;
ELWord(LineY - MaxYBelow - MaxYAbove); COMMENT BOTTOM;
ELWord(RGTMAR-TLFTMAR); COMMENT WIDTH;
ELWord(MaxYAbove + MaxYBelow); COMMENT HEIGHT;
ELWord(1+(ELPos-ELbeg) div 2);
END "CLOSEL" ;
ENDC
SIMPLE PROCEDURE IMPOSSIBLE(STRING HOW) ;
BEGIN "IMPOSSIBLE"
IF SG > -1 THEN
BEGIN
OUTSTR(CRLF & HOW & " Error."&CRLF&
"This is an encoding of text line " & CVS(LINE) & ":" & CRLF) ;
FOR I ← 1 THRU SG DO OUTSTR(SEG[I]) ;
END ;
WARN("A supposedly impossible condition has been encountered."&CRLF&
"This is most likely a PUB bug. However, you may have an error"&CRLF&
"which produced unanticipated line lengths or other strange effects."&
(IF DEBUG THEN CRLF&"Line/Page: "&SRCREF[LINE] ELSE NULL)) ;
END "IMPOSSIBLE" ;
SIMPLE PROCEDURE SLIDERROR ;
BEGIN
IMPOSSIBLE(CVS(SLIDETOP)&" Horizontal Positioning") ;
SLIDETOP ← 1 ;
END ;
SIMPLE PROCEDURE RIGHTBOUND ;
BEGIN "RIGHTBOUND" COMMENT RIGHT BOUND OF ∞ ;
PLK: procedure reworked on 6-FEB-75;
integer DEST, CURRENT, NFSIZE, TEMP; string FILLER, OLBF;
NFSIZE←FSIZE-OFSIZE[SLIDETOP];
DEST←(RB[SLIDETOP]-NFSIZE) div DIVISOR[SLIDETOP];
CURRENT←LBD[SLIDETOP]+OFSIZE[SLIDETOP];
OLBF←LBF[SLIDETOP];
FILLER←null;
if RASTER then
begin "RASTER"
if fulstr(OLBF) then
begin "XGP INFINITY"
TEMP←(DEST-CURRENT) div XINFSTRL[SLIDETOP]; PLK: this is how many we can get in ;
while TEMP>0 do
begin TEMP←TEMP-1; FILLER←FILLER&OLBF; end;
SEG[TEMP←SLIDESG[SLIDETOP]] ← FILLER;
SEG[TEMP+1]←RUBOUT & "=" & cvs(DEST);
end "XGP INFINITY"
else SEG[SLIDESG[SLIDETOP]] ← RUBOUT & "=" & cvs(DEST);
end "RASTER"
else
begin "NON RASTER"
if fulstr(OLBF) then
begin "INFINITY"
TEMP←DEST-CURRENT;
while length(FILLER)<TEMP do
FILLER←FILLER&OLBF;
if length(FILLER)>TEMP then
FILLER←FILLER[1 to TEMP];
SEG[SLIDESG[SLIDETOP]]←FILLER;
end "INFINITY"
else SEG[SLIDESG[SLIDETOP]]←RUBOUT & "=" & cvs(DEST);
end "NON RASTER";
CHRS←DEST;
BRKS←0; FSTCHRS←CHRS; FSTBRK←SG; comment nojust to left;
FSIZE←(IF DIVISOR[SLIDETOP]=2 THEN (NFSIZE DIV 2) ELSE 0);
SLIDETOP←SLIDETOP-1;
END "RIGHTBOUND";
SIMPLE INTEGER PROCEDURE STEP!SG ;
IF SG<8*IMC THEN RETURN(SG←SG+1)
ELSE BEGIN
IMPOSSIBLE("Line complexity") ;
RETURN(SG←0) ;
END ;
IF PAGEHIGH THEN GO TO CONTINUE ; comment, re-entered ;
AWHILE DO
BEGIN "FILE"
PAGEFILE ← SPARAM ;
IF SEQEOF THEN DONE ;
PAGEFILES[NPAGEFILES←NPAGEFILES+1] ← PAGEFILE ; TES 4/6/75 ;
IFC TENEX THENC
IFILE ← IFILENAME & OCTEXT & PAGEFILE ;
SFILE ← IFILENAME & TXTEXT & PAGEFILE ;
ELSEC
IFILE ← PAGEFILE & PUIEXT ; SFILE ← PAGEFILE & "S"&PUIEXT ;
ENDC
ICHAN ← READIN(IFILE, TRUE, PAGEBRC, PAGEEOF) ; SCHAN ← READIN(SFILE, FALSE, PAGEBRC, PAGEEOF) ;
AWHILE DO
BEGIN "PAGE"
PAGEHIGH ← INNUM ;
IF PAGEEOF OR PAGEHIGH LEQ 0 THEN DONE ; PAGEWIDE ← INNUM ;
LFTMAR ← 0 MAX (INNUM*HBPI + 500) DIV 1000 - MINLFTMAR ; TES 6/11/74 ADDED ;
RGTMAR ← 0 MAX ((8500-INNUM)*HBPI + 500) DIV 1000 - MINLFTMAR ; TES 8/29/74 ADDED ;
COMMENT HBPI HORIZ BITS PER INCH, MINLFTMAR BIT MIN MARGIN;
IF NOT MICRO AND (PAGEHIGH > IML OR PAGEWIDE > IMC) THEN
BEGIN "EXPAND"
IFC SAILVER THENC
IF DEVICE=MIC THEN
BEGIN "FRAME SIZE"
IF LASL NEQ 1000 THEN OUT(LISTCHAN, ENDPAGE) ;
NVERTI ← 11000 DIV PAGEHIGH MIN 16384 DIV PAGEWIDE MIN 375 ;
NHORIZ ← 10*NVERTI DIV 11 ; NCSIZE ← (9*NHORIZ DIV 80)*8 ;
OUT(LISTCHAN, SETSIZE(NCSIZE)&SETHORIZ(NHORIZ)&SETVERTI(NVERTI)) ;
END "FRAME SIZE"
ELSE IF DEVICE = LPT THEN
BEGIN
IF (LASL-1) MOD 66 + 1 LEQ 6 AND (PAGEHIGH-1) MOD 66 < 60 THEN
OUT(LISTCHAN, ENDPAGE) ;
ENDLINE ← IF PAGEHIGH GEQ 54 THEN RUBOUT & '21 ELSE LF ;
END ;
ENDC;
IML ← PAGEHIGH ; IMC ← PAGEWIDE ;
DONE ; comment, Exit "SIZE" block and immediately reenter with bigger IMG array ;
END "EXPAND" ;
CONTINUE: OUTSTR(SP & CVS(PAGECT ← PAGECT + 1)) ; AVAIL ← IML ;
comment *****CurrentY now points to the top of the current entity*****;
FromTop ← 11*VBPI - TopMar;
RASTPHIGH ← 11*VBPI - (TOPMAR+BOTMAR) ;
RASTLHIGH ← FNTINF[1];
IFC SAILVER THENC
IF PAGECT > 1 THEN
IF DEVICE = LPT THEN COMMENT AVOID SPURIOUS BLANK PAGE ;
IF (IML-1) MOD 66 < 60 THEN OUT(LISTCHAN, ENDPAGE)
ELSE FOR L ← (LASL-1) MOD 66 + 2 THRU 66 DO
BEGIN OUT(LISTCHAN, CR) ; OUT(LISTCHAN, ENDLINE) END
ELSE
IF DEVICE ≠ MIC THEN COMMENT JLG 9/11/85 NOT NEEDED IN PRESS FILE;
OUT(LISTCHAN, ENDPAGE) ;
ENDC
IFC CMUXGP THENC
IF PAGECT>1 THEN OUT(LISTCHAN,ENDPAGE);
ENDC
IFC SAILVER OR PARCVER THENC
IF MICRO THEN
BEGIN
FSTFONT ← -1 ; comment FSTFONT is justify info ;
DLBP ← DLBP1 ; comment byte pointer having to do with justification ;
TLIX ← 0 ; comment an integer declared in PARCARRAY ;
END ;
ENDC
WHILE (TOPLINE ← INNUM) > -10 DO
BEGIN "AREA"
NCOLS ← INNUM ; NLINES ← INNUM ;
FOR COL ← 1 THRU NCOLS DO
BEGIN "COLUMN"
LastMaxYBelow ← 0; COMMENT JLG NEEDED SO CURRENTY IS SET CORRECTLY IN OPENLINE;
LastMaxYAbove ← 0;
LastLine ← 0;
LineY ← FromTop - (FntInf[1] * (TopLine - 1));
LEFTCH ← INNUM ;
TLFTMAR ← LFTMAR + CHARW*(LEFTCH-1) ; TVR: Initiallize left margin for this column ;
WHILE (LINENO ← INNUM) DO
BEGIN "LINE"
SH ← SHORTM ← INNUM ;
MLEAD ← INNUM ; TES 11/2/74 ;
SG ← FSTBRK ← -1 ;
BRKS ← CHRS ← FSTCHRS ← SLIDETOP ← 0 ;
LINE ← TOPLINE - 1 + LINENO ;
IF LINE<1 OR LINE>PAGEHIGH THEN
BEGIN
WARN("Area outside page. If Pass one didn't tell you too, then there is a bug in PUB");
LINE←LINE MAX 1 MIN PAGEHIGH ;
END ;
L ← INNUM ; F ← L MOD FIML ; OWL ← OWLS[F] ;
IF FULSTR(OWL) THEN BEGIN FROMFILE ← FALSE ; OWLS[F] ← NULL END
ELSE BEGIN FROMFILE ← TRUE ;
WHILE L NEQ (M←CVD(INPUT(SCHAN, TO!ALTMODE!SKIP))) DO
BEGIN S ← NULL ;
RKJ: 4-26-74, added EOF stuff on next two lines ;
DO S ← S & INPUT(SCHAN, TO!LF!APPD) UNTIL PAGEBRC = LF OR PAGEEOF ;
IF PAGEEOF THEN USERERR(0,0,"Bad input from Pass One (a PUB bug), I give up.");
OWLS[M MOD FIML] ← S ;
END ;
END ;
IF NOT DEBUG THEN S ← SCN(TO!ALTMODE!SKIP)
ELSE BEGIN
SR ← IF MICRO THEN NULL ELSE SRCREF[LINE] ;
SR ← SR & " " & SCN(TO!RUB!ALT!SKIP) ;
WHILE PAGEBRC NEQ ALTMODE DO
BEGIN "ERROR MESSG"
S ← SCN(TO!RUB!ALT!SKIP) ; M ← LENGTH(S)+3 ; L ← LINE ;
IF DEVICE=TTY OR (IMC MAX 75)+13*(NCOLS-COL)+LENGTH(SR)+M LEQ 119 THEN
SR ← SR & "..." & S ;
END "ERROR MESSG" ;
IF NOT MICRO THEN SRCREF[LINE] ← SR ;
END ;
DO BEGIN "PIECE"
S ← SCN(BREAKER) ; TES 11/6/74 ;
WHILE NOT PAGEEOF AND NOT PAGEBRC DO
S ← S & SCN(BREAKER) ; TES 11/6/74 ;
CHRS ← CHRS + LENGTH(SEG[STEP!SG] ← S) ;
CASE CHARTBL[PAGEBRC] OF
BEGIN comment by BRC ;
comment 0 ... ; IMPOSSIBLE("0"&CVOS(PAGEBRC)&" Break Character") ;
comment 1 ... RUBOUT -- Font change ; BEGIN
SEG[STEP!SG] ← RUBOUT & (F←SCN(ONE!CHAR)) &
(S ← IF F="-" OR F="+" OR F="=" THEN SCN(TO!ALTMODE!SKIP)
ELSE IF F = "F" THEN SCN(ONE!CHAR)
ELSE IF F = "V" THEN LENGTH(S←SCN(TO!ALTMODE!SKIP)) & S TES 3/29/75 ;
ELSE IF F="π" THEN SCNBYCOUNT(SCNUM) TES 1/11/75 SCNUM ;
ELSE NULL) ;
IF F = "π" THEN CHRS ← CHRS + TES 9/10/75: ;
(IFC PARCVER THENC IF DEVICE=TTY THEN 0 ELSE ENDC 1)
ELSE IF F = "+" THEN CHRS ← CHRS + CVD(S)
ELSE IF F = "-" THEN CHRS ← CHRS - CVD(S)
ELSE IF F = "→" THEN
BEGIN COMMENT ∞ ;
IF (SLIDETOP ← SLIDETOP + 1) > 5 THEN SLIDERROR ;
SLIDESG[SLIDETOP] ← SG ; RB[SLIDETOP] ← SCNUM ;
LBD[SLIDETOP] ← SCNUM ;
DIVISOR[SLIDETOP] ← SCNUM ;
IF RASTER THEN
PLK; XINFSTRL[SLIDETOP]← SCNUM ;
LBF[SLIDETOP] ← SCN(TO!ALTMODE!SKIP) ;
IF RASTER AND FULSTR(LBF[SLIDETOP]) THEN STEP!SG ; RKJ: 1-9-74;
OFSIZE[SLIDETOP]←FSIZE;
END
ELSE IF F = "←" THEN
RIGHTBOUND
ELSE IF F = "=" THEN BEGIN
comment 8/9/73 RKJ IF RASTER THEN SHORTM←(SHORTM-BRKS*CHARW) MAX 0;
BRKS←0 ; FSTCHRS←CHRS←CVD(S) ; FSTBRK←SG END ;
END ; COMMENT NOJUST LEFT OF TAB ;
comment 2 ... ALTMODE -- Word Break ; BEGIN BRKS ← BRKS + 1 ; SEG[STEP!SG] ← ALTMODE END ;
comment 3 ... VT -- label reference ;
BEGIN "LABEL REF"
STRING S;
S ← LABTAB[(F←SCNUM) LSH -14, F LAND '37777] ;
L ← LENGTH(SEG[STEP!SG] ← SCAN(S, TO!ALTMODE!SKIP, DUMMY)) ;
J ← CVD(S) ;
SHORTM ← SHORTM - (IF RASTER THEN J ELSE L) ; CHRS ← CHRS + L ;
FSIZE←FSIZE+(IF RASTER THEN J ELSE L);
END "LABEL REF" ;
comment 4 ... CR -- Justify it ;
BEGIN "JUSTIFY"
WHILE SLIDETOP DO BEGIN SLIDERROR ; RIGHTBOUND END ;
IF SHORTM < 0 THEN SHORTM ← 0 ;
BEGIN "DISTRIBUTE SPACES";
COMMENT beta(α,K) = [α(K+1)] - [αK], PJ 5/27/74 ITS doesn't like <control-C>'s
WHERE α = SHORTM/BRKS, is h.m. spaces to insert at the K'th break ;
TOTBRKS←BRKS;
RATIO ← IF BRKS=0 THEN 0.0 ELSE SHORTM/BRKS;
TERM ← RATIO + .0001;
BRKS ← 1;
END "DISTRIBUTE SPACES" ;
UNDERLINE←-1 ; LINE←TOPLINE-1+LINENO MAX 1 MIN PAGEHIGH ; CHAR ← 0 MAX LEFTCH-1 MAX 0 ;
IFC CMUVER THENC IF XCRIBL THEN CHAR←LASC[LINE]; ENDC RKJ: 7-Nov-74, needed for multi column;
NOTFST ← FALSE ; CHRS ← CHRS + CHAR ;
TVR: Initial column select for XGP ;
IF XCRIBL AND (LEFTCH NEQ 1 OR LFTMAR > 0) THEN XGPTAB(0) ;
IFC SAILVER OR PARCVER THENC IF MICRO THEN OPENLINE(0, -1) ; ENDC
IF XCRIBL THEN LEADING[LINE] ← TES 11/4/74; RKJ: 7-Nov-74;
IF MLEAD = 0 THEN 0
ELSE IF MLEAD > 0 THEN (MLEAD*VBPI + 500) DIV 1000
ELSE -((-MLEAD*VBPI + 500) DIV 1000) ;
FOR G ← 0 THRU SG DO IF FULSTR(S ← SEG[G]) THEN CASE CHARTBL[S] OF
BEGIN comment three cases ;
comment 0 ... text ;
BEGIN "TEXT SEG"
IF UNDERLINE<0 OR BAR=0 TES 10/22/73 ; THEN
RKJ: modified 8-Nov-74;
BEGIN
IFC CMUVER THENC
IF SCRLVL NEQ 0 THEN CMUSCRIPT(SCRLVL,S) ELSE CHAR←APPD(S);
ELSEC
CHAR ← 0 MAX APPD(S);
ENDC
END ELSE
COMMENT *** UNDERLINING *** ;
IF DEVICE = MIC THEN
IFC not SAILVER THENC
BEGIN K ← LENGTH(S) ;
WHILE K DO
BEGIN COMMENT DON'T UNDERLINE BLANKS ;
N ← LOP(S) ;
IF N=SP THEN BEGIN UNDERSCORE(CHAR-K) ; UNDERLINE←UNDERLINE+1 END ;
K ← K - 1 ;
END ;
END
ENDC
IFC sailver or PARCVER THENC
begin integer x,i;
x←0;
for i←1 thru length(s) do x←x+CW[s[i for 1]];
Show;
SetPosD(ELSetX,CURRENTX);
SetPosD(ELSetY,CURRENTY-80);
ELByte(ELShowRectangle);
ELWord(x); ELWord(20);
SetPos(ELSetY,CURRENTY);
APPD(s);
end
ENDC
ELSE IF XCRIBL THEN
BEGIN
IFC CMUXGP THENC
RKJ: New code for new XGP system at CMU 8-Nov-74 and 6-Feb-75;
CTRL(CMU!UND(BAR));
CHAR←0 MAX APPD(S);
CTRL(CMU!UND(0));
ENDC
IFC ISIVER THENC
K←LENGTH(S); SS←0&SPS(K*4); N←LOP(SS);
START!CODE "XGPUNDER"
DEFINE LEN= [2],SRC= [3],DEST= [4],RUB= [5],ESC= [6],R= [7],CNT= ['10],UBAR= ['11];
LABEL LOOP,ELOOP,SPACE,OUTT;
SETZ CNT,0; MOVE LEN,K; MOVE SRC,S; MOVE DEST,SS; MOVEI RUB,'177; MOVEI ESC,'35; MOVE UBAR,BAR;
LOOP: ILDB R,SRC;
CAIE R,BAR; CAIN R,SP; JRST SPACE;
IDPB RUB,DEST; IDPB ESC,DEST; IDPB R,DEST; IDPB UBAR,DEST;
ELOOP: SOJG LEN,LOOP;
MOVEM CNT,N; JRST OUTT;
SPACE: IDPB R,DEST;
AOJA CNT,ELOOP;
OUTT:
END "XGPUNDER";
CHAR ← 0 MAX APPD(SS[1 TO (K*4-N*3)])-(K-N)*3;
LASC[L]←CHAR; FAKE[L]←FAKE[L]+(K-N)*3;
ENDC
IFC SAILXGP THENC CHAR ← 0 MAX APPD(S); ENDC
IFC PARCVER THENC
K←LENGTH(S); SS←0&SPS(K*3); N←LOP(SS);
START!CODE "XGPUNDER"
DEFINE LEN= [2],SRC= [3],DEST= [4],BS= [5],UBAR= [6],CNT= [7],R= ['10];
LABEL LOOP, OUTT, NOBAR; TES 8/19/74 TES CHAR BS BAR -> BAR BS CHAR, FOR BOBROW ;
SETZ CNT,0;
MOVE LEN,K; MOVE SRC,S; MOVE DEST,SS; MOVEI BS,'10; MOVE UBAR,BAR;
LOOP: SOJL LEN,OUTT;
ILDB R,SRC;
CAIE R,BAR; CAIN R,SP; AOJA CNT,NOBAR;
IDPB UBAR,DEST; IDPB BS,DEST;
NOBAR: IDPB R,DEST;
JUMPA LOOP;
OUTT: MOVEM CNT,N;
END "XGPUNDER";
CHAR ← 0 MAX APPD(SS[1 TO (K*3-N*2)])-(K-N)*2;
LASC[L]←CHAR; FAKE[L]←FAKE[L]+(K-N)*2;
ENDC
END
ELSE BEGIN CHAR ← 0 MAX APPD(S);
K ← LENGTH(S) ; SS ← 0&S ; N ← LOP(SS) ; CHAR ← 0 MAX CHAR-K ;
IFC NOT CMUXGP THENC RKJ: 1-7-74;
START!CODE "UNDER" LABEL LOOP ;
MOVE 2, K ; MOVE 3, SS ;
LOOP: ILDB 4,3 ; CAIE 4,SP ; CAIN 4,BAR ; CAIA 0,0 ; MOVE 4,BAR ; DPB 4,3 ; SOJG 2,LOOP ;
END "UNDER" ; CHAR ← 0 MAX APPD(SS[1 TO LENGTH(S)]) ;
ELSEC CHAR ← 0 MAX APPD(S); ENDC RKJ: 1-7-74;
END ;
END "TEXT SEG" ;
comment 1 ... RUBOUT -- Font Change ;
IF (F←S[2 FOR 1])="↑" THEN
IFC SAILVER THENC IF DEVICE=MIC THEN
SetPos(ELSetY,(CURRENTY←CURRENTY+SubSuperAmt(1,RASTLHIGH)))
ELSE ENDC
IFC PARCVER THENC
IF MICRO THEN PARCSUPER ELSE
IF XCRIBL THEN
IF (SCRLVL←SCRLVL+SCRIPT) LEQ 0 THEN CTRL("R"-'100) ELSE
BEGIN LABEL L1;
CTRL("U"-'100);
L1:
IF G<SG THEN
BEGIN
SS←SEG[G+1];
IF NULSTR(SS) THEN BEGIN G←G+1; GO L1 END; comment try again ;
IF EQU(SS[1 FOR 2],RUBOUT&"F") THEN
BEGIN
G←G+1;
CTRL(SS[3 FOR 1]);
END ELSE CTRL(THISFONT+"0");
END ELSE CTRL(THISFONT+"0")
END
ELSE ENDC
IFC CMUVER THENC
IF XCRIBL THEN SCRLVL←SCRLVL+SCRIPT ELSE
ENDC RKJ: 22-OCT-74;
IFC SAILXGP THENC
IF XCRIBL THEN
CTRL(ESCAPE1&'43&(SCRLVL←SCRLVL+SCRIPT))
ELSE ENDC LINE←LINE-1 MAX 1
ELSE IF F = "↓" THEN
IFC SAILVER THENC IF DEVICE=MIC THEN
SetPos(ELSetY,(CURRENTY←CURRENTY-SubSuperAmt(-1,RASTLHIGH)))
ELSE ENDC
IFC PARCVER THENC
IF MICRO THEN PARCSUB ELSE
IF XCRIBL THEN
IF (SCRLVL←SCRLVL-SCRIPT) GEQ 0 THEN CTRL("R"-'100) ELSE
BEGIN LABEL L2;
CTRL("S"-'100);
L2:
IF G<SG THEN
BEGIN
SS←SEG[G+1];
IF NULSTR(SS) THEN BEGIN G←G+1; GO L2 END; comment ↑↑↑ ;
IF EQU(SS[1 FOR 2],RUBOUT&"F") THEN
BEGIN
G←G+1;
CTRL(SS[3 FOR 1]);
END ELSE CTRL(THISFONT+"0");
END ELSE CTRL(THISFONT+"0")
END
ELSE ENDC
IFC CMUVER THENC
IF XCRIBL THEN SCRLVL←SCRLVL-SCRIPT ELSE
ENDC RKJ: 22-OCT-74;
IFC SAILXGP THENC
IF XCRIBL THEN
CTRL(ESCAPE1&'43&(SCRLVL←SCRLVL-SCRIPT)) ELSE ENDC LINE←LINE+1 MIN IML
ELSE IF F = "_" THEN
BEGIN
UNDERLINE ← CHAR;
IFC SAILVER THENC
IF XCRIBL THEN CTRL(ESCAPE1&'46);
ENDC
IFC ITSVER PJ 8/23/74 ; THENC
IF XCRIBL THEN BEGIN CTRL(ESCAPE1&'46); CTRL(ESCAPE1&'46) END;
ENDC
END
ELSE IF F = "≡" THEN
BEGIN "END UNDERLINED TEXT"
IFC SAILVER THENC
IF DEVICE = MIC AND BAR TES 10/22/73; THEN UNDERSCORE(CHAR) ;
ENDC
UNDERLINE ← -1 ;
IFC SAILVER THENC
IF XCRIBL AND BAR TES 10/22/73; THEN
CTRL(ESCAPE1&'51&2&3); TES AND REG 11/19/73 ; BH 12/3/74;
ENDC
IFC ITSVER THENC PJ 8/23/74 ;
IF XCRIBL AND BAR THEN BEGIN CTRL(ESCAPE1&'47&3); CTRL(ESCAPE1&'47&4) END;
ENDC
END "END UNDERLINED TEXT"
ELSE IF F="-" THEN
BEGIN
F ← CVD(S[3 TO ∞]) ;
IF DEVICE=MIC THEN
IFC SAILVER THENC
SetPos(ELSetX,CURRENTX←CURRENTX - F*CHARW MAX 0)
ENDC
IFC PARCVER THENC
PARCLEFT
ENDC
ELSE CHAR←CHAR-F MAX 0
END
ELSE IF F="*" THEN CHAR ← 0 MAX LASC[LINE] comment not always correct! ;
ELSE IF F="+" THEN
BEGIN F ← CVD(S[3 TO ∞]) ;
IFC SAILVER THENC
IF DEVICE=MIC THEN
BEGIN
CURRENTX ← CURRENTX + F ; TES 10/9/74 ;
SetPos(ELSetX, CURRENTX);
END
ELSE ENDC
IFC PARCVER THENC
PARCRIGHT
ENDC
IF XCRIBL THEN CTRL(VARBLANK(F))
ELSE CHAR←CHAR+F MIN IMC
END
ELSE IF F="=" THEN
BEGIN "TAB"
F ← CVD(S[3 TO ∞]) ;
IF NOT RASTER THEN F ← (F MAX 0) + LEFTCH - 1 MIN IMC ; TES 8/17/74 FIX BUG ;
IF XCRIBL THEN XGPTAB(F)
ELSE IF DEVICE NEQ MIC THEN CHAR ← F
IFC SAILVER THENC
ELSE IF F+TLFTMAR ≠ CURRENTX THEN
SetPos(ELSetX,CURRENTX←F+TLFTMAR)
ENDC
IFC PARCVER THENC PARCTAB ENDC
END "TAB"
comment need to alter this !!! jlj ;
ELSE IF F = "π" THEN
BEGIN TES 11/29/73 REWROTE ; TES 3/29/75 DELETED SPECIAL ;
IFC CMUXGP THENC
IF UNDERLINE GEQ 0 AND BAR THEN CTRL(RUBOUT&'35) ;
ENDC TES 12/13/73 ;
SS ← UNMASH(S[3 TO ∞]) ;
IFC PARCVER THENC
IF XCRIBL THEN
IF SS="." THEN F←LOP(SS) tes 12/10/74 ;
ELSE SS ← CTLQ & SS ;
IF MICRO THEN CHAR ← 0 MAX APPD(SS)-LENGTH(SS)+1 TES 3/29/75 ;
ELSE
ENDC
BEGIN
IFC CMUVER THENC
IF XCRIBL AND SCRLVL THEN
IF SCRLVL>0 THEN CTRL(CMU!SUP(SCRLVL,0)) ELSE CTRL(CMU!SUB(SCRLVL,0));
ENDC RKJ: 6-Feb-75 ;
F ← IFC PARCVER THENC 0 ELSEC 1 ENDC ; TES 9/10/75 ;
F ← LENGTH(SS)-F ; TES 9/10/75 ;
CHAR ← 0 MAX APPD(SS)-F ;
LASC[L] ← CHAR ; FAKE[L] ← FAKE[L] + F ;
IF UNDERLINE GEQ 0 AND BAR AND DEVICE NEQ MIC
IFC SAILXGP THENC AND NOT XCRIBL ENDC
THEN CTRL(IFC PARCVER THENC '10& ENDC BAR) ; TES 12/13/73;
END ;
END
ELSE IF F = "←" THEN BEGIN END
ELSE IF F="F" THEN FONTSELECT(S[3 FOR 1])
ELSE IF F="V" THEN IFC sailver or PARCVER THENC
BEGIN
INTEGER NEWCOPYNUMBER, N ;
N ← S[2 FOR 1] ;
NEWCOPYNUMBER ← IF N=0 THEN 0 ELSE CVD(S[3 TO 2+N]) ;
IF NEWCOPYNUMBER NEQ COPYNUMBER THEN
BEGIN
COPYNUMBER ← NEWCOPYNUMBER ;
Comment !!!!!! need something eventually !!!! ;
END ;
END
ENDC
ELSE IF F='35 THEN COMMENT OVERSTRIKE NEXT CHAR OVER LAST ;
BEGIN "OVERSTRIKE"
IFC CMUXGP THENC
INTEGER Q;
Q←IMG[L][(LASC[L]+FAKE[L]) FOR 1];
LASC[L]←LASC[L]-1; CHAR ← 0 MAX CHAR-1;
CTRL(RUBOUT&'35); CHAR ← 0 MAX APPD(Q);
ENDC
IFC SAILXGP THENC WARN("Overstrike unimplemented"); ENDC
IFC sailver OR PARCVER THENC
IF MICRO THEN
BEGIN integer tx ;
K ← LDB(DLBP) ; COMMENT LAST CHARACTER OUTPUT ;
IF K>'177 THEN
WARN("ATTEMPT TO OVERLAY A DIRECTIVE")
ELSE BEGIN
F ← LOP(SEG[G+1]) ;
tx←CURRENTX;
SetPos(ELSetX,tx-CW[K]);
APPD(F);
CURRENTX←tx;
SetPos(ELSetX,CURRENTX);
END ;
END
ELSE CTRL('10)
ENDC
END
ELSE IF F="S" THEN SNUCK[LINE]←TRUE RKJ: 6-FEB-75 ;
ELSE IF F=RUBOUT THEN IF NOT XCRIBL THEN CHAR←APPD(SP) ELSE
BEGIN
CHAR ← 0 MAX APPD(RUBOUT&RUBOUT)-1; LASC[L]←CHAR; FAKE[L]←FAKE[L]+1;
END
ELSE IMPOSSIBLE("0"&CVOS(F)&" Control Character") ;
comment 2 ... ALTMODE -- word break ;
IF SHORTM AND G > FSTBRK THEN
BEGIN "SPREAD"
TERMX ← RATIO*(BRKS←BRKS+1) + .0001 ;
IF RASTER THEN
BEGIN "DOVSB"
F ← ((TERMX-TERM) MIN SHORTM) ;
Comment F has desired mica spacing, using an exact computation.
We will actually put out SpaceX, so record accordingly. After
a while, we decrease SpaceX to get line to come out exactly right;
IFC sailver or PARCVER THENC IF MICRO THEN
BEGIN "parcj" integer a,nx;
nx←CURRENTX←CURRENTX+F;
if PressBug then Outstr("="&cvs(F)&","&cvs(SpaceX));
if a geq 0 and (BRKS-1=totbrks or (a=1 and BRKS=totbrks div 2)) then
SetPos(ELSetX, CURRENTX)
else begin
wordbreak←true; comment don't think space is quoted;
APPD(SP);
wordbreak←false;
end;
CURRENTX←nx; comment because APPD updates it;
BrkToChange←BrkToChange-1;
if BrkToChange=0 then SetSpace(SpaceX-1);
END "parcj"
ELSE ENDC
CTRL(VARBLANK(F)) ;
SHORTM← SHORTM-F
END "DOVSB"
ELSE CHAR ← 0 MAX CHAR + TERMX - TERM MIN IMC ;
TERM ← TERMX ;
END "SPREAD"
ELSE IF RASTER THEN
BEGIN
CHAR ← 0 MAX APPD(SP);
END;
comment 3-5 ; IMPOSSIBLE("VT in SEG[]") ; IMPOSSIBLE("CR in SEG[]") ; IMPOSSIBLE("LF in SEG[]") ;
END ; COMMENT three cases ;
IFC SAILVER THENC IF CHORIZ NEQ NHORIZ THEN CTRL(SETHORIZ(NHORIZ)) ; ENDC
IFC SAILXGP THENC
IF XCRIBL AND UNDERLINE GEQ 0 THEN
CTRL(ESCAPE1&'47&BASELINE);
ENDC
BRKS ← CHRS ← FSTCHRS ← SLIDETOP ← 0 ; SG ← FSTBRK ← -1 ; SHORTM ← SH ;
IFC PARCVER OR SAILVER THENC
IF MICRO THEN CLOSELINE ;
ENDC
LastMaxYAbove ← MaxYAbove;
LastMaxYBelow ← MaxYBelow;
MaxYBelow ← MaxYAbove ← 0;
LastLine ← Line;
END "JUSTIFY" ;
comment 5 ... LF ; BEGIN END ;
END ; comment, by BRC ;
END "PIECE"
UNTIL PAGEBRC = LF ;
END "LINE" ;
END "COLUMN" ;
END "AREA" ;
IFC SAILVER OR PARCVER THENC
IF MICRO THEN
IF ELPos = 0 THEN COMMENT BLANK PAGES ARE SUPPRESSED ;
ELSE BEGIN "PUTPD"
APPD('0&'0);
while (BYTECOUNT(DLBP,DLBP1) mod 2) neq 0 do APPD(0);
WISHPMAP ; COMMENT WRITE OUT DL ;
ELOut; comment write out EL;
PD[PDIX] ← 0 ;
PD[PDIX+1] ← DLREC ;
dlgone←outcount mod 256;
PD[PDIX+3] ← (if dlgone=0 then 0 else 256-dlgone);
DLREC ← MICPAD ;
PD[PDIX+2] ← DLREC-PD[PDIX+1] ;
PDIX ← PDIX + 4 ;
DLgone←0;
END "PUTPD"
ELSE
ENDC
BEGIN "FINPAGE"
comment MICRO = FALSE to get here ;
FOR LASL ← PAGEHIGH DOWN 1 DO IF LASC[LASL] THEN DONE ;
F ← 120 - (IMC MAX 78) ;
FOR N ← 1 THRU LASL DO
BEGIN "LIST LINE"
L ← N ;
IF DEBUG AND LENGTH(S←SRCREF[L])>F AND DEVICE=LPT THEN
S←S[1 TO F] ;
NEEDCR ← FALSE ;
DO BEGIN "PART LINE"
IF CHAR ← LASC[L] THEN
BEGIN "NONBLANK"
IF NEEDCR THEN OUT(LISTCHAN, RESTARTLINE)
ELSE NEEDCR ← TRUE ; TES 11/1/73;
OUT(LISTCHAN, FIXUP(IMG[L][1 TO CHAR+FAKE[L]])) ;
IFC CMUVER THENC RKJ: 26-SEP-74 - KLUDGE;
IF XCRIBL AND FIRST!OUTPUT THEN
BEGIN
FIRST!OUTPUT←FALSE;
DUMMY←CHNCDB(LISTCHAN);
START!CODE
MOVE 1,DUMMY; HLRZ 1,2(1); MOVE 2,1(1);
MOVEI 3,1; MOVEM 3,1(2);
END;
END;
ENDC
IF DEBUG AND L=N AND FULSTR(S) THEN OUT(LISTCHAN,
(IF XCRIBL THEN XTABSTR(LFTMAR+IMC*CHARW+1)
ELSE SPS((IMC MAX 80)-CHAR)) RKJ: 1-4-74;
& S);
END "NONBLANK" ;
CHAR ← 0 MAX L ; L ← LINK[CHAR] ;
LINK[CHAR] ← LASC[CHAR] ← FAKE[CHAR] ← 0 ;
END "PART LINE" UNTIL L=0 ;
RKJ: 6-FEB-75 JUGGLED FOLLOWING CODE FOR SNUCK ;
IF NOT SNUCK[N] THEN
BEGIN "NOT SNUCK"
OUT(LISTCHAN, CR) ; COMMENT ALWAYS CR BEFORE LF ;
L ← N ; DO L←L+1 UNTIL NOT SNUCK[L] ; COMMENT FIND NEXT REAL LINE ;
IF NEEDVERTI AND
((L ← LEADING[L]+RASTVERTI) IFC SAILXGP THENC NEQ ELSEC > ENDC INTRA) THEN
IFC PARCVER THENC
BEGIN
OUT(LISTCHAN, ENDLINE) ;
OUT(LISTCHAN, CTLK&CVS(L-INTRA)&".") ;
END
ENDC
IFC CMUVER THENC OUT(LISTCHAN, ENDLINE & CMU!ISL(L-INTRA)) ENDC
IFC ISIVER THENC OUT(LISTCHAN, ENDLINE) ENDC comment *** ;
IFC SAILXGP THENC OUT(LISTCHAN, ESCAPE1&'42&(L+1)) ENDC BH 11/19/74 *** ;
ELSE
OUT(LISTCHAN, ENDLINE) ;
END "NOT SNUCK";
SNUCK[N] ← FALSE ; RKJ: 6-FEB-75 ;LEADING[N] ← 0 ; TES 11/4/74 ;
IF DEBUG THEN SRCREF[N] ← NULL ;
END "LIST LINE" ;
FOR N ← LASL+1 THRU PAGEHIGH DO FAKE[N]←LINK[N]←0 ; TES 4/4/74 ;
IFC ITSVER THENC OUT(LISTCHAN, ENDPAGE) ; ENDC
IFC PARCVER THENC
OUT(LISTCHAN, ENDPAGE) ;
ENDC
END "FINPAGE" ;
END "PAGE" ;
IF NOT (PAGEEOF OR PAGEHIGH LEQ 0) THEN DONE ; comment expand IMG ;
RELEASE(ICHAN) ; RELEASE(SCHAN) ;
END "FILE" ;
END "SIZE" UNTIL SEQEOF ;
IFC SAILVER OR PARCVER THENC
IF MICRO THEN
BEGIN "FDTODD" integer f,logdir, PPN, X,
DayHalf, Day, Mo, Yr, TimeHalf, Min, Hr;
String PPNStr, DATE, B, MinStr;
for f←lofont thru hifont do if FULSTR(FNTNAME[f]) then
begin string fam; integer pt,face;
ELWord(16);
ELByte(0);
ELByte(FntNumber[F]);
ELByte(FNTBC[F]);
ELByte(FNTEC[F]);
FONTTYPE(FNTNAME[f], fam, pt, face);
BCPLString(fam, 19);
ELByte(FNTFACE[F]);
ELByte(FNTBC[F]); COMMENT SOURCE;
ELWord(FNTSIZ[F]);
ELWord(0); COMMENT ROTATION;
END;
ELWord(0);
ELOut;
PDREC←MICPAD; Comment next record is part directory;
PD[PDIX]←1;
PD[PDIX+1]←DLREC;
PD[PDIX+2]←PDREC-DLREC;
PDIX←PDIX+4;
MICOUT(PD,PDIX);
DDREC←MICPAD;
ELWord(27183);
ELWord(DDREC+1);
ELWord(PDIX div 4);
ELWord(PDREC);
ELWord(DDREC-PDREC);
ELWord(-1); comment back-pointer to obsolete document directory;
ELWord(-1); comment unused;
ELWord(-1); comment unused;
ELWord(1); ELWord(1); comment copy numbers;
for i←10 thru '177 do ELWord(-1); comment unused;
BCPLString(LISTFILE, 51);
PPN ← Call(0,"GetPPN");
PPN ← PPN LAND '777777;
PPNStr ← B ← CVXSTR(PPN);
WHILE LOP(B) = " " DO
PPNSTR ← PPNSTR[2 TO LENGTH(PPNSTR)];
BCPLString(PPNStr, 31);
X ← Call(0, "AccTim");
DayHalf ← (X LSH -18);
TimeHalf ← (X LAND '777777);
Day ← (DayHalf MOD 31) + 1;
Mo ← ((DayHalf DIV 31) MOD 12) + 1;
Yr ← ((DayHalf DIV 31) DIV 12) + 1964;
Hr ← ((TimeHalf DIV 60) DIV 60);
Min ← ((TimeHalf DIV 60) MOD 60);
MinStr ← CVS(Min);
IF LENGTH(MinStr) = 1 THEN
MinStr ← "0" & MinStr;
DATE ← CVS(DAY)&" "&MONTHS[MO]&" "&CVS(YR)&" "&CVS(HR)&":"& MinStr;
BCPLSTRING(DATE, 37);
ELOut;
MicPad;
ifc not sailver thenc
Comment Alto-format date in words 6,7. Algorithm courtesy
E. Fiala: take lh of GTAD (days since 17 Nov 1858), subtract to
get days since 1 Jan 1901, convert to seconds, and add in seconds
in the current day (rh of GTAD);
i←GTAD; ELDWord(((i lsh -18)-15385)*(3600*24)+(i land '777777));
ELWord(1); ELWord(1); comment copy numbers;
for i←10 thru '177 do ELWord(-1);
BCPLString(LISTFILE, 51);
GJINF(logdir,DUMMY,DUMMY);
BCPLString(DIRST(logdir),31);
BCPLString(ODTIM(-1,-1),37);
ELOut;
MICPAD;
SFBSZ(LISTCHAN, 8) ;
endc
END "FDTODD" ;
ENDC
IFC SAILVER THENC IF NOT MICRO THEN OUT(LISTCHAN, ENDPAGE) ; ENDC
COMMENT IF NOT MICRO ADDED BY JLG 9/3/85;
RELEASE(LISTCHAN) ; RELEASE(SEQCHAN) ;
END "INNER BLOCK" ;
BEGIN EXTERNAL SIMPLE PROCEDURE K!OUT ; K!OUT END ; COMMENT ** ** ** ** ** ;
IF DELINT="A" OR DELINT="a" THEN
BEGIN
OUTSTR(CRLF & "DELETE INTERMEDIATE FILES?(Y OR N,CR)") ;
DELINT ← INCHWL ;
END ;
IF DELINT="Y" OR DELINT="y" THEN
BEGIN "DELETE INTERMEDIATE FILES"
IFC TENEX THENC
SIMPLE PROCEDURE DELVER(STRING FINAME) ;
BEGIN INTEGER CHN ;
CHN ← OPENFILE(FINAME&";*", "RO*") ;
DO DELF(CHN) UNTIL NOT INDEXFILE(CHN) ;
RELEASE(CHN) ;
END ;
IF (I←GTJFN(JOBNO&".PASS2", 0)) GEQ 0 THEN TES 4/6/75 ;
BEGIN
RLJFN(I) ;
DELVER(JOBNO & ".PASS2") ;
END ;
ENDC
TES 4/6/75 DOING PUPSEQ LIKE PULABL ;
IFC TENEX THENC DELVER(IFILENAME & ".FILES") ; ELSEC
SEQCHAN ← READIN("PUPSEQ"&PUIEXT, FALSE, SEQBRC, SEQEOF) ;
RENAME(SEQCHAN, NULL, 0, I) ;
RELEASE(SEQCHAN);
ENDC
IFC TENEX THENC DELVER(IFILENAME & ".LABELS") ; ELSEC
LABCHAN ← READIN("PULABL"&PUIEXT, FALSE, LABBRC, LABEOF) ;
RENAME(LABCHAN, NULL, 0, I) ;
RELEASE(LABCHAN);
ENDC
FOR I ← 1 THRU NPAGEFILES DO TES 4/6/75 USING ARRAY ;
BEGIN
PAGEFILE ← PAGEFILES[I] ;
IFC TENEX THENC
DELVER(IFILENAME & OCTEXT & PAGEFILE) ;
DELVER(IFILENAME & TXTEXT & PAGEFILE) ;
ELSEC
IFILE ← PAGEFILE & PUIEXT ; SFILE ← PAGEFILE & "S"&PUIEXT ;
ICHAN ← READIN(IFILE, TRUE, PAGEBRC, PAGEEOF) ;
SCHAN ← READIN(SFILE, FALSE, PAGEBRC, PAGEEOF) ;
RENAME(ICHAN, NULL, 0, Dummy) ; RENAME(SCHAN, NULL, 0, Dummy) ;
RELEASE(ICHAN); RELEASE(SCHAN);
ENDC
END ;
TES 4/6/75 NO LONGER READING PUPSEQ AT TERMINATION ;
END "DELETE INTERMEDIATE FILES"
ELSE IF DELINT NEQ "N" AND DELINT NEQ "n" THEN
OUTSTR(CRLF&DELINT&"? -- INTERMEDIATE FILES WERE NOT DELETED") ;
OUTSTR("." & CRLF) ; comment signal terminal that pass two is done ;
IF DEVICE = MIC THEN
PTOSTR(0,"DOVER " & LISTFILE)
ELSE
IF DEVICE = XGP THEN
PTOSTR(0,"R XPART; " & LISTFILE);
IFC NOT SAILVER THENC
IF DEVICE = MIC THEN
BEGIN "PASS 3"
INTEGER FCHAN ;
INTEGER SIMPLE PROCEDURE CORELOC(INTEGER ARRAY A) ; START!CODE MOVE 1, A ; END ;
INTEGER ARRAY PASSTHREE[0:4] ;
FCHAN ← WRITEON("$PUB$"&RPGEXT,0) ;
OUT(FCHAN, LISTFILE&CRLF&TMPFILE&CRLF&"F"&CRLF&FF) ;
RELEASE(FCHAN) ;
PASSTHREE[0] ← CVSIX("DSK") ;
PASSTHREE[1] ← CVFIL("TXTF80[1,3]", PASSTHREE[2], PASSTHREE[4]) ;
PASSTHREE[3] ← 1 ; COMMENT STARTING ADDRESS IS NORMAL + 1 ;
OUTSTR("PRODUCING FR80 FILE" & CRLF) ;
CALL(CORELOC(PASSTHREE), "SWAP") ;
END "PASS 3" ;
IF XCRIBL THEN LODED("XSPOOL "&LISTFILE&CRLF);
ENDC
IFC CMUVER THENC
RKJ: 26-SEP-74 ALL NEW CODE;
IF XCRIBL AND DOPASS3 THEN
BEGIN "PASS 3"
WTMPFILE("PB3",LISTFILE&CR&LF,TRUE);
RUNPROG("DSK:PUB3[A700PU00]",1);
START!CODE CALLI 0,'12 END;
END "PASS 3";
RKJ: NOW CHECK FOR MORE COMMANDS IN THE TMP FILE;
IF RTMPFILE("PUB",S,FALSE,TRUE) THEN
BEGIN "RERUN"
RUNPROG("PUB",1);
START!CODE CALLI 0,'12 END;
END "RERUN";
ENDC
IFC ISIVER THENC
TES 8-OCT-74 APPROXIMATION TO WHAT ISI NEEDS;
IF XCRIBL AND DOPASS3 THEN
BEGIN "PASS 3"
INTEGER J, JOBNO ;
JOBNO ← CVS(GJINF(J, I, J)) ;
J ← OPENFILE(JOBNO & ".PASS3", "WT") ;
OUT(J, LISTFILE & CRLF) ;
RELEASE(J) ;
RUNPRG("<SUBSYS>PUB3.SAV", 1, 0) ;
CALL(0,"EXIT") ;
END "PASS 3" ;
ENDC
IFC TENEX THENC CALL(1,"EXIT") ; CALL(0,"EXIT"); ELSEC
START!CODE IFC NOT ITSVER THENC CALLI 1,'12; ENDC CALLI 0,'12; END;
ENDC
MAKEBE(WCW, CW) ;
END "VARIABLE BOUND ARRAY BLOCK" ;
END "PUB2" ;